library(tidyverse)
## -- Attaching packages ----------------------------------------------- tidyverse 1.2.1 --
## v ggplot2 3.2.1 v purrr 0.3.2
## v tibble 2.1.3 v dplyr 0.8.3
## v tidyr 1.0.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.4.0
## -- Conflicts -------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(readxl)
library(dplyr)
library(gganimate)
library(stringr)
library(gifski)
library(png)
d = read_excel("C:/Users/student/Downloads/c2015.xlsx")
d = d %>% filter_all(~!is.na(.))
d = d %>% filter_all(~!(.=='Unknown'))
d = d %>% filter_all(~!(.=='Not Rep'))
d = d %>% filter_all(~!(.==str_detect(.,'Unknown')))
d = d %>% filter_all(~!(.==str_detect(.,'Not Rep')))
d = d %>% filter_all(~!(.=='Not Reported'))
d = d %>% filter(SEAT_POS == 'Front Seat, Left Side')
d$TRAV_SP <- str_replace(d$TRAV_SP, " MPH","")
d$TRAV_SP <- str_replace(d$TRAV_SP, "No Rep","")
d$TRAV_SP <- str_replace(d$TRAV_SP, "Unknown","")
d$TRAV_SP <- as.numeric(d$TRAV_SP)
## Warning: NAs introduced by coercion
d = d[!(is.na(d$TRAV_SP)),]
dd = d %>%
group_by(MONTH) %>%
summarize(avgspeed = mean(TRAV_SP, na.rm = TRUE))
dd$avgspeed_z <- round((dd$avgspeed - mean(dd$avgspeed, na.rm = TRUE))/sd(dd$avgspeed, na.rm = TRUE), 2)
dd$avgspeed_z
## [1] -0.24 1.42 1.24 -2.17 -0.54 0.22 0.21 -0.70 -0.39 0.23 1.17
## [12] -0.46
dd$avgspeedtype <- ifelse(dd$avgspeed_z < 0, "below", "above")
dd <- dd[order(dd$avgspeed_z), ]
dd$'MONTH' <- factor(dd$MONTH, levels = dd$MONTH)
ggplot(dd, aes(x = MONTH, y = avgspeed_z)) +
geom_bar(stat = "identity", aes(fill = avgspeedtype)) +
scale_fill_manual(name="Standardized Speed", labels = c("Above Average", "Below Average"), values = c("above"="#00ba38", "below"="#f8766d")) +
labs(title = 'MONTH = {closest_state}') +
transition_states(MONTH) +
coord_flip()
dd = d %>%
group_by(MONTH, INJ_SEV, SEX) %>%
mutate(avgspeed = mean(TRAV_SP, na.rm = TRUE))
ggplot(dd, aes(x = DRINKING, y = avgspeed)) +
geom_bar(stat = "identity", aes(fill = SEX)) +
labs(title = 'MONTH = {closest_state}') +
transition_states(MONTH) +
coord_flip()
library(datapasta)
data <- tibble::tribble(
~Quarter, ~Mortgage, ~HE.Revolving, ~Auto.Loan, ~Credit.Card, ~Student.Loan, ~Other, ~Total,
"03:Q1", 4.94, 0.24, 0.64, 0.69, 0.24, 0.48, 7.23,
"03:Q2", 5.08, 0.26, 0.62, 0.69, 0.24, 0.49, 7.38,
"03:Q3", 5.18, 0.27, 0.68, 0.69, 0.25, 0.48, 7.56,
"03:Q4", 5.66, 0.3, 0.7, 0.7, 0.25, 0.45, 8.07,
"04:Q1", 5.84, 0.33, 0.72, 0.7, 0.26, 0.45, 8.29,
"04:Q2", 5.97, 0.37, 0.74, 0.7, 0.26, 0.42, 8.46,
"04:Q3", 6.21, 0.43, 0.75, 0.71, 0.33, 0.41, 8.83,
"04:Q4", 6.36, 0.47, 0.73, 0.72, 0.35, 0.42, 9.04,
"05:Q1", 6.51, 0.5, 0.73, 0.71, 0.36, 0.39, 9.21,
"05:Q2", 6.7, 0.53, 0.77, 0.72, 0.37, 0.4, 9.49,
"05:Q3", 6.91, 0.54, 0.83, 0.73, 0.38, 0.41, 9.79,
"05:Q4", 7.1, 0.57, 0.79, 0.74, 0.39, 0.42, 10,
"06:Q1", 7.44, 0.58, 0.79, 0.72, 0.43, 0.42, 10.38,
"06:Q2", 7.76, 0.59, 0.8, 0.74, 0.44, 0.42, 10.75,
"06:Q3", 8.05, 0.6, 0.82, 0.75, 0.45, 0.44, 11.11,
"06:Q4", 8.23, 0.6, 0.82, 0.77, 0.48, 0.41, 11.31,
"07:Q1", 8.42, 0.61, 0.79, 0.76, 0.51, 0.4, 11.5,
"07:Q2", 8.71, 0.62, 0.81, 0.8, 0.51, 0.41, 11.85,
"07:Q3", 8.93, 0.63, 0.82, 0.82, 0.53, 0.41, 12.13,
"07:Q4", 9.1, 0.65, 0.82, 0.84, 0.55, 0.42, 12.37,
"08:Q1", 9.23, 0.66, 0.81, 0.84, 0.58, 0.42, 12.54,
"08:Q2", 9.27, 0.68, 0.81, 0.85, 0.59, 0.4, 12.6,
"08:Q3", 9.29, 0.69, 0.81, 0.86, 0.61, 0.41, 12.68,
"08:Q4", 9.26, 0.71, 0.79, 0.87, 0.64, 0.41, 12.67,
"09:Q1", 9.14, 0.71, 0.77, 0.84, 0.66, 0.41, 12.53,
"09:Q2", 9.06, 0.71, 0.74, 0.82, 0.68, 0.39, 12.41,
"09:Q3", 8.94, 0.71, 0.74, 0.81, 0.69, 0.38, 12.28,
"09:Q4", 8.84, 0.71, 0.72, 0.8, 0.72, 0.38, 12.17,
"10:Q1", 8.83, 0.7, 0.7, 0.76, 0.76, 0.36, 12.12,
"10:Q2", 8.7, 0.68, 0.7, 0.74, 0.76, 0.35, 11.94,
"10:Q3", 8.61, 0.67, 0.71, 0.73, 0.78, 0.34, 11.84,
"10:Q4", 8.45, 0.67, 0.71, 0.73, 0.81, 0.34, 11.71,
"11:Q1", 8.54, 0.64, 0.71, 0.7, 0.84, 0.33, 11.75,
"11:Q2", 8.52, 0.62, 0.71, 0.69, 0.85, 0.33, 11.73,
"11:Q3", 8.4, 0.64, 0.73, 0.69, 0.87, 0.33, 11.66,
"11:Q4", 8.27, 0.63, 0.73, 0.7, 0.87, 0.33, 11.54,
"12:Q1", 8.19, 0.61, 0.74, 0.68, 0.9, 0.32, 11.44,
"12:Q2", 8.15, 0.59, 0.75, 0.67, 0.91, 0.31, 11.38,
"12:Q3", 8.03, 0.57, 0.77, 0.67, 0.96, 0.31, 11.31,
"12:Q4", 8.03, 0.56, 0.78, 0.68, 0.97, 0.32, 11.34,
"13:Q1", 7.93, 0.55, 0.79, 0.66, 0.99, 0.31, 11.23,
"13:Q2", 7.84, 0.54, 0.81, 0.67, 0.99, 0.3, 11.15,
"13:Q3", 7.9, 0.54, 0.85, 0.67, 1.03, 0.3, 11.28,
"13:Q4", 8.05, 0.53, 0.86, 0.68, 1.08, 0.32, 11.52,
"14:Q1", 8.17, 0.53, 0.88, 0.66, 1.11, 0.31, 11.65,
"14:Q2", 8.1, 0.52, 0.91, 0.67, 1.12, 0.32, 11.63,
"14:Q3", 8.13, 0.51, 0.93, 0.68, 1.13, 0.33, 11.71,
"14:Q4", 8.17, 0.51, 0.96, 0.7, 1.16, 0.34, 11.83,
"15:Q1", 8.17, 0.51, 0.97, 0.68, 1.19, 0.33, 11.85,
"15:Q2", 8.12, 0.5, 1.01, 0.7, 1.19, 0.34, 11.85,
"15:Q3", 8.26, 0.49, 1.05, 0.71, 1.2, 0.35, 12.07,
"15:Q4", 8.25, 0.49, 1.06, 0.73, 1.23, 0.35, 12.12,
"16:Q1", 8.37, 0.49, 1.07, 0.71, 1.26, 0.35, 12.25,
"16:Q2", 8.36, 0.48, 1.1, 0.73, 1.26, 0.36, 12.29,
"16:Q3", 8.35, 0.47, 1.14, 0.75, 1.28, 0.37, 12.35,
"16:Q4", 8.48, 0.47, 1.16, 0.78, 1.31, 0.38, 12.58,
"17:Q1", 8.63, 0.46, 1.17, 0.76, 1.34, 0.37, 12.73,
"17:Q2", 8.69, 0.45, 1.19, 0.78, 1.34, 0.38, 12.84,
"17:Q3", 8.74, 0.45, 1.21, 0.81, 1.36, 0.39, 12.96,
"17:Q4", 8.88, 0.44, 1.22, 0.83, 1.38, 0.39, 13.15,
"18:Q1", 8.94, 0.44, 1.23, 0.82, 1.41, 0.39, 13.21,
"18:Q2", 9, 0.43, 1.24, 0.83, 1.41, 0.39, 13.29,
"18:Q3", 9.14, 0.42, 1.27, 0.84, 1.44, 0.4, 13.51,
"18:Q4", 9.12, 0.41, 1.27, 0.87, 1.46, 0.41, 13.54,
"19:Q1", 9.24, 0.41, 1.28, 0.85, 1.49, 0.4, 13.67,
"19:Q2", 9.41, 0.4, 1.3, 0.87, 1.48, 0.41, 13.86
)
ggplot(data, aes(Student.Loan, Credit.Card)) + geom_line()
ggplot(data, aes(Student.Loan, Credit.Card)) + geom_line() + transition_reveal(Student.Loan)
data$date <- seq.Date(as.Date("2003/1/1"), as.Date("2019/4/1"), by = "quarter")
data$date
## [1] "2003-01-01" "2003-04-01" "2003-07-01" "2003-10-01" "2004-01-01"
## [6] "2004-04-01" "2004-07-01" "2004-10-01" "2005-01-01" "2005-04-01"
## [11] "2005-07-01" "2005-10-01" "2006-01-01" "2006-04-01" "2006-07-01"
## [16] "2006-10-01" "2007-01-01" "2007-04-01" "2007-07-01" "2007-10-01"
## [21] "2008-01-01" "2008-04-01" "2008-07-01" "2008-10-01" "2009-01-01"
## [26] "2009-04-01" "2009-07-01" "2009-10-01" "2010-01-01" "2010-04-01"
## [31] "2010-07-01" "2010-10-01" "2011-01-01" "2011-04-01" "2011-07-01"
## [36] "2011-10-01" "2012-01-01" "2012-04-01" "2012-07-01" "2012-10-01"
## [41] "2013-01-01" "2013-04-01" "2013-07-01" "2013-10-01" "2014-01-01"
## [46] "2014-04-01" "2014-07-01" "2014-10-01" "2015-01-01" "2015-04-01"
## [51] "2015-07-01" "2015-10-01" "2016-01-01" "2016-04-01" "2016-07-01"
## [56] "2016-10-01" "2017-01-01" "2017-04-01" "2017-07-01" "2017-10-01"
## [61] "2018-01-01" "2018-04-01" "2018-07-01" "2018-10-01" "2019-01-01"
## [66] "2019-04-01"
ggplot(data, aes(date, Student.Loan)) + geom_line()
ggplot(data, aes(date, Student.Loan)) + geom_line() + transition_reveal(date)
ggplot(data, aes(date, Student.Loan)) + geom_point() + geom_text(aes(label = Student.Loan)) + transition_reveal(date)
head(data)
## # A tibble: 6 x 9
## Quarter Mortgage HE.Revolving Auto.Loan Credit.Card Student.Loan Other
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 03:Q1 4.94 0.24 0.64 0.69 0.24 0.48
## 2 03:Q2 5.08 0.26 0.62 0.69 0.24 0.49
## 3 03:Q3 5.18 0.27 0.68 0.69 0.25 0.48
## 4 03:Q4 5.66 0.3 0.7 0.7 0.25 0.45
## 5 04:Q1 5.84 0.33 0.72 0.7 0.26 0.45
## 6 04:Q2 5.97 0.37 0.74 0.7 0.26 0.42
## # ... with 2 more variables: Total <dbl>, date <date>
newdata <- gather(data, debttype, amount, Mortgage:Other, factor_key = TRUE)
newdata
## # A tibble: 396 x 5
## Quarter Total date debttype amount
## <chr> <dbl> <date> <fct> <dbl>
## 1 03:Q1 7.23 2003-01-01 Mortgage 4.94
## 2 03:Q2 7.38 2003-04-01 Mortgage 5.08
## 3 03:Q3 7.56 2003-07-01 Mortgage 5.18
## 4 03:Q4 8.07 2003-10-01 Mortgage 5.66
## 5 04:Q1 8.29 2004-01-01 Mortgage 5.84
## 6 04:Q2 8.46 2004-04-01 Mortgage 5.97
## 7 04:Q3 8.83 2004-07-01 Mortgage 6.21
## 8 04:Q4 9.04 2004-10-01 Mortgage 6.36
## 9 05:Q1 9.21 2005-01-01 Mortgage 6.51
## 10 05:Q2 9.49 2005-04-01 Mortgage 6.7
## # ... with 386 more rows
debt <- c(data$Mortgage, data$He.Revolving, data$Auto.Loan, data$Credit.Card, data$Student.Loan, data$Other)
## Warning: Unknown or uninitialised column: 'He.Revolving'.
ggplot(newdata, aes(date)) + geom_line(aes(y = amount, color = debttype)) + transition_reveal(date)
datatwo <- gather(data, debttype, amount, Mortgage:Total, factor_key = TRUE)
datatwo
## # A tibble: 462 x 4
## Quarter date debttype amount
## <chr> <date> <fct> <dbl>
## 1 03:Q1 2003-01-01 Mortgage 4.94
## 2 03:Q2 2003-04-01 Mortgage 5.08
## 3 03:Q3 2003-07-01 Mortgage 5.18
## 4 03:Q4 2003-10-01 Mortgage 5.66
## 5 04:Q1 2004-01-01 Mortgage 5.84
## 6 04:Q2 2004-04-01 Mortgage 5.97
## 7 04:Q3 2004-07-01 Mortgage 6.21
## 8 04:Q4 2004-10-01 Mortgage 6.36
## 9 05:Q1 2005-01-01 Mortgage 6.51
## 10 05:Q2 2005-04-01 Mortgage 6.7
## # ... with 452 more rows
toptwo <- datatwo %>%
filter(debttype == c("Mortgage", "Total"))
ggplot(toptwo, aes(date)) + geom_line(aes(y = amount, color = debttype)) + transition_reveal(date) + ggtitle("Total Debt and Mortgage Debt in Trillions of Dollars")
#It appears that the amount of Mortgage is very correlated with the amount of Total Debt in the U.S.
restofdata <- datatwo %>%
filter(debttype == c("HE.Revolving", "Auto.Loan", "Credit.Card", "Student.Loan", "Other"))
## Warning in `==.default`(debttype, c("HE.Revolving", "Auto.Loan",
## "Credit.Card", : longer object length is not a multiple of shorter object
## length
## Warning in is.na(e1) | is.na(e2): longer object length is not a multiple of
## shorter object length
ggplot(restofdata, aes(date)) + geom_line(aes(y = amount, color = debttype)) + transition_reveal(date) + ggtitle("All Other Debts in Trillions of Dollars")
#The amount of debt from student loans and auto loans have increased dramatically over the last several years.
# I took the data from the January 2019 excel speadsheet
library(datapasta)
economy <- tibble::tribble(
~Date, ~Unemployment.Rate, ~Labor.Force.Participation.Rate, ~Employment.Population.Ratio,
"Jan-2000", 4, 67.3, 64.6,
"Feb-2000", 4.1, 67.3, 64.6,
"Mar-2000", 4, 67.3, 64.6,
"Apr-2000", 3.8, 67.3, 64.7,
"May-2000", 4, 67.1, 64.4,
"Jun-2000", 4, 67.1, 64.5,
"Jul-2000", 4, 66.9, 64.2,
"Aug-2000", 4.1, 66.9, 64.2,
"Sep-2000", 3.9, 66.9, 64.2,
"Oct-2000", 3.9, 66.8, 64.2,
"Nov-2000", 3.9, 66.9, 64.3,
"Dec-2000", 3.9, 67, 64.4,
"Jan-2001", 4.2, 67.2, 64.4,
"Feb-2001", 4.2, 67.1, 64.3,
"Mar-2001", 4.3, 67.2, 64.3,
"Apr-2001", 4.4, 66.9, 64,
"May-2001", 4.3, 66.7, 63.8,
"Jun-2001", 4.5, 66.7, 63.7,
"Jul-2001", 4.6, 66.8, 63.7,
"Aug-2001", 4.9, 66.5, 63.2,
"Sep-2001", 5, 66.8, 63.5,
"Oct-2001", 5.3, 66.7, 63.2,
"Nov-2001", 5.5, 66.7, 63,
"Dec-2001", 5.7, 66.7, 62.9,
"Jan-2002", 5.7, 66.5, 62.7,
"Feb-2002", 5.7, 66.8, 63,
"Mar-2002", 5.7, 66.6, 62.8,
"Apr-2002", 5.9, 66.7, 62.7,
"May-2002", 5.8, 66.7, 62.9,
"Jun-2002", 5.8, 66.6, 62.7,
"Jul-2002", 5.8, 66.5, 62.7,
"Aug-2002", 5.7, 66.6, 62.7,
"Sep-2002", 5.7, 66.7, 63,
"Oct-2002", 5.7, 66.6, 62.7,
"Nov-2002", 5.9, 66.4, 62.5,
"Dec-2002", 6, 66.3, 62.4,
"Jan-2003", 5.8, 66.4, 62.5,
"Feb-2003", 5.9, 66.4, 62.5,
"Mar-2003", 5.9, 66.3, 62.4,
"Apr-2003", 6, 66.4, 62.4,
"May-2003", 6.1, 66.4, 62.3,
"Jun-2003", 6.3, 66.5, 62.3,
"Jul-2003", 6.2, 66.2, 62.1,
"Aug-2003", 6.1, 66.1, 62.1,
"Sep-2003", 6.1, 66.1, 62,
"Oct-2003", 6, 66.1, 62.1,
"Nov-2003", 5.8, 66.1, 62.3,
"Dec-2003", 5.7, 65.9, 62.2,
"Jan-2004", 5.7, 66.1, 62.3,
"Feb-2004", 5.6, 66, 62.3,
"Mar-2004", 5.8, 66, 62.2,
"Apr-2004", 5.6, 65.9, 62.3,
"May-2004", 5.6, 66, 62.3,
"Jun-2004", 5.6, 66.1, 62.4,
"Jul-2004", 5.5, 66.1, 62.5,
"Aug-2004", 5.4, 66, 62.4,
"Sep-2004", 5.4, 65.8, 62.3,
"Oct-2004", 5.5, 65.9, 62.3,
"Nov-2004", 5.4, 66, 62.5,
"Dec-2004", 5.4, 65.9, 62.4,
"Jan-2005", 5.3, 65.8, 62.4,
"Feb-2005", 5.4, 65.9, 62.4,
"Mar-2005", 5.2, 65.9, 62.4,
"Apr-2005", 5.2, 66.1, 62.7,
"May-2005", 5.1, 66.1, 62.8,
"Jun-2005", 5, 66.1, 62.7,
"Jul-2005", 5, 66.1, 62.8,
"Aug-2005", 4.9, 66.2, 62.9,
"Sep-2005", 5, 66.1, 62.8,
"Oct-2005", 5, 66.1, 62.8,
"Nov-2005", 5, 66, 62.7,
"Dec-2005", 4.9, 66, 62.8,
"Jan-2006", 4.7, 66, 62.9,
"Feb-2006", 4.8, 66.1, 63,
"Mar-2006", 4.7, 66.2, 63.1,
"Apr-2006", 4.7, 66.1, 63,
"May-2006", 4.6, 66.1, 63.1,
"Jun-2006", 4.6, 66.2, 63.1,
"Jul-2006", 4.7, 66.1, 63,
"Aug-2006", 4.7, 66.2, 63.1,
"Sep-2006", 4.5, 66.1, 63.1,
"Oct-2006", 4.4, 66.2, 63.3,
"Nov-2006", 4.5, 66.3, 63.3,
"Dec-2006", 4.4, 66.4, 63.4,
"Jan-2007", 4.6, 66.4, 63.3,
"Feb-2007", 4.5, 66.3, 63.3,
"Mar-2007", 4.4, 66.2, 63.3,
"Apr-2007", 4.5, 65.9, 63,
"May-2007", 4.4, 66, 63,
"Jun-2007", 4.6, 66, 63,
"Jul-2007", 4.7, 66, 62.9,
"Aug-2007", 4.6, 65.8, 62.7,
"Sep-2007", 4.7, 66, 62.9,
"Oct-2007", 4.7, 65.8, 62.7,
"Nov-2007", 4.7, 66, 62.9,
"Dec-2007", 5, 66, 62.7,
"Jan-2008", 5, 66.2, 62.9,
"Feb-2008", 4.9, 66, 62.8,
"Mar-2008", 5.1, 66.1, 62.7,
"Apr-2008", 5, 65.9, 62.7,
"May-2008", 5.4, 66.1, 62.5,
"Jun-2008", 5.6, 66.1, 62.4,
"Jul-2008", 5.8, 66.1, 62.2,
"Aug-2008", 6.1, 66.1, 62,
"Sep-2008", 6.1, 66, 61.9,
"Oct-2008", 6.5, 66, 61.7,
"Nov-2008", 6.8, 65.9, 61.4,
"Dec-2008", 7.3, 65.8, 61,
"Jan-2009", 7.8, 65.7, 60.6,
"Feb-2009", 8.3, 65.8, 60.3,
"Mar-2009", 8.7, 65.6, 59.9,
"Apr-2009", 9, 65.7, 59.8,
"May-2009", 9.4, 65.7, 59.6,
"Jun-2009", 9.5, 65.7, 59.4,
"Jul-2009", 9.5, 65.5, 59.3,
"Aug-2009", 9.6, 65.4, 59.1,
"Sep-2009", 9.8, 65.1, 58.7,
"Oct-2009", 10, 65, 58.5,
"Nov-2009", 9.9, 65, 58.6,
"Dec-2009", 9.9, 64.6, 58.3,
"Jan-2010", 9.8, 64.8, 58.5,
"Feb-2010", 9.8, 64.9, 58.5,
"Mar-2010", 9.9, 64.9, 58.5,
"Apr-2010", 9.9, 65.2, 58.7,
"May-2010", 9.6, 64.9, 58.6,
"Jun-2010", 9.4, 64.6, 58.5,
"Jul-2010", 9.4, 64.6, 58.5,
"Aug-2010", 9.5, 64.7, 58.6,
"Sep-2010", 9.5, 64.6, 58.5,
"Oct-2010", 9.4, 64.4, 58.3,
"Nov-2010", 9.8, 64.6, 58.2,
"Dec-2010", 9.3, 64.3, 58.3,
"Jan-2011", 9.1, 64.2, 58.3,
"Feb-2011", 9, 64.1, 58.4,
"Mar-2011", 9, 64.2, 58.4,
"Apr-2011", 9.1, 64.2, 58.4,
"May-2011", 9, 64.1, 58.3,
"Jun-2011", 9.1, 64, 58.2,
"Jul-2011", 9, 64, 58.2,
"Aug-2011", 9, 64.1, 58.3,
"Sep-2011", 9, 64.2, 58.4,
"Oct-2011", 8.8, 64.1, 58.4,
"Nov-2011", 8.6, 64.1, 58.6,
"Dec-2011", 8.5, 64, 58.6,
"Jan-2012", 8.3, 63.7, 58.4,
"Feb-2012", 8.3, 63.8, 58.5,
"Mar-2012", 8.2, 63.8, 58.5,
"Apr-2012", 8.2, 63.7, 58.4,
"May-2012", 8.2, 63.7, 58.5,
"Jun-2012", 8.2, 63.8, 58.6,
"Jul-2012", 8.2, 63.7, 58.5,
"Aug-2012", 8.1, 63.5, 58.4,
"Sep-2012", 7.8, 63.6, 58.7,
"Oct-2012", 7.8, 63.8, 58.8,
"Nov-2012", 7.7, 63.6, 58.7,
"Dec-2012", 7.9, 63.7, 58.7,
"Jan-2013", 8, 63.7, 58.6,
"Feb-2013", 7.7, 63.4, 58.6,
"Mar-2013", 7.5, 63.3, 58.5,
"Apr-2013", 7.6, 63.4, 58.6,
"May-2013", 7.5, 63.4, 58.6,
"Jun-2013", 7.5, 63.4, 58.6,
"Jul-2013", 7.3, 63.3, 58.7,
"Aug-2013", 7.2, 63.3, 58.7,
"Sep-2013", 7.2, 63.2, 58.7,
"Oct-2013", 7.2, 62.8, 58.3,
"Nov-2013", 6.9, 63, 58.6,
"Dec-2013", 6.7, 62.9, 58.7,
"Jan-2014", 6.6, 62.9, 58.8,
"Feb-2014", 6.7, 62.9, 58.7,
"Mar-2014", 6.7, 63.1, 58.9,
"Apr-2014", 6.2, 62.8, 58.9,
"May-2014", 6.3, 62.9, 58.9,
"Jun-2014", 6.1, 62.8, 59,
"Jul-2014", 6.2, 62.9, 59,
"Aug-2014", 6.1, 62.9, 59,
"Sep-2014", 5.9, 62.8, 59.1,
"Oct-2014", 5.7, 62.9, 59.3,
"Nov-2014", 5.8, 62.9, 59.2,
"Dec-2014", 5.6, 62.8, 59.3,
"Jan-2015", 5.7, 62.9, 59.3,
"Feb-2015", 5.5, 62.7, 59.2,
"Mar-2015", 5.4, 62.6, 59.2,
"Apr-2015", 5.4, 62.7, 59.3,
"May-2015", 5.6, 62.9, 59.4,
"Jun-2015", 5.3, 62.6, 59.3,
"Jul-2015", 5.2, 62.6, 59.3,
"Aug-2015", 5.1, 62.6, 59.4,
"Sep-2015", 5, 62.4, 59.2,
"Oct-2015", 5, 62.5, 59.3,
"Nov-2015", 5.1, 62.6, 59.4,
"Dec-2015", 5, 62.7, 59.6,
"Jan-2016", 4.9, 62.7, 59.7,
"Feb-2016", 4.9, 62.8, 59.8,
"Mar-2016", 5, 62.9, 59.8,
"Apr-2016", 5, 62.8, 59.7,
"May-2016", 4.8, 62.7, 59.7,
"Jun-2016", 4.9, 62.7, 59.6,
"Jul-2016", 4.8, 62.8, 59.7,
"Aug-2016", 4.9, 62.9, 59.8,
"Sep-2016", 5, 62.9, 59.8,
"Oct-2016", 4.9, 62.8, 59.7,
"Nov-2016", 4.7, 62.7, 59.8,
"Dec-2016", 4.7, 62.7, 59.8,
"Jan-2017", 4.7, 62.9, 59.9,
"Feb-2017", 4.7, 62.9, 59.9,
"Mar-2017", 4.4, 62.9, 60.1,
"Apr-2017", 4.4, 62.9, 60.2,
"May-2017", 4.4, 62.8, 60,
"Jun-2017", 4.3, 62.8, 60.1,
"Jul-2017", 4.3, 62.9, 60.1,
"Aug-2017", 4.4, 62.9, 60.1,
"Sep-2017", 4.2, 63.1, 60.4,
"Oct-2017", 4.1, 62.7, 60.2,
"Nov-2017", 4.2, 62.8, 60.1,
"Dec-2017", 4.1, 62.7, 60.2,
"Jan-2018", 4.1, 62.7, 60.2,
"Feb-2018", 4.1, 63, 60.4,
"Mar-2018", 4, 62.9, 60.4,
"Apr-2018", 3.9, 62.8, 60.3,
"May-2018", 3.8, 62.8, 60.4,
"Jun-2018", 4, 62.9, 60.4,
"Jul-2018", 3.9, 62.9, 60.5,
"Aug-2018", 3.8, 62.7, 60.3,
"Sep-2018", 3.7, 62.7, 60.4,
"Oct-2018", 3.8, 62.9, 60.6,
"Nov-2018", 3.7, 62.9, 60.6,
"Dec-2018", 3.9, 63.1, 60.6
)
head(economy)
## # A tibble: 6 x 4
## Date Unemployment.Rate Labor.Force.Participati~ Employment.Population~
## <chr> <dbl> <dbl> <dbl>
## 1 Jan-20~ 4 67.3 64.6
## 2 Feb-20~ 4.1 67.3 64.6
## 3 Mar-20~ 4 67.3 64.6
## 4 Apr-20~ 3.8 67.3 64.7
## 5 May-20~ 4 67.1 64.4
## 6 Jun-20~ 4 67.1 64.5
economy$date <- seq.Date(as.Date("2000/1/1"), as.Date("2018/12/1"), by = "month")
ggplot(economy, aes(date, Unemployment.Rate)) + geom_line() + transition_reveal(date)
housing <- tibble::tribble(
~Date, ~Housing.Starts.and.Completions.Calculations, ~Housing.Starts.and.Completions,
"Jan-2000", 343, 1321,
"Feb-2000", 394, 1299,
"Mar-2000", 380, 1279,
"Apr-2000", 375, 1281,
"May-2000", 329, 1273,
"Jun-2000", 351, 1236,
"Jul-2000", 341, 1191,
"Aug-2000", 329, 1192,
"Sep-2000", 314, 1189,
"Oct-2000", 312, 1220,
"Nov-2000", 322, 1214,
"Dec-2000", 320, 1224,
"Jan-2001", 323, 1238,
"Feb-2001", 325, 1260,
"Mar-2001", 347, 1258,
"Apr-2001", 352, 1270,
"May-2001", 343, 1271,
"Jun-2001", 333, 1297,
"Jul-2001", 344, 1293,
"Aug-2001", 331, 1293,
"Sep-2001", 324, 1276,
"Oct-2001", 300, 1256,
"Nov-2001", 326, 1242,
"Dec-2001", 314, 1256,
"Jan-2002", 340, 1282,
"Feb-2002", 330, 1368,
"Mar-2002", 353, 1370,
"Apr-2002", 331, 1357,
"May-2002", 342, 1324,
"Jun-2002", 342, 1349,
"Jul-2002", 348, 1364,
"Aug-2002", 356, 1313,
"Sep-2002", 359, 1339,
"Oct-2002", 347, 1348,
"Nov-2002", 338, 1397,
"Dec-2002", 335, 1395,
"Jan-2003", 341, 1457,
"Feb-2003", 331, 1426,
"Mar-2003", 324, 1412,
"Apr-2003", 308, 1358,
"May-2003", 319, 1388,
"Jun-2003", 328, 1426,
"Jul-2003", 359, 1480,
"Aug-2003", 355, 1511,
"Sep-2003", 365, 1525,
"Oct-2003", 356, 1557,
"Nov-2003", 370, 1627,
"Dec-2003", 378, 1657,
"Jan-2004", 383, 1634,
"Feb-2004", 375, 1563,
"Mar-2004", 361, 1558,
"Apr-2004", 363, 1586,
"May-2004", 351, 1643,
"Jun-2004", 329, 1608,
"Jul-2004", 319, 1618,
"Aug-2004", 321, 1631,
"Sep-2004", 337, 1640,
"Oct-2004", 365, 1635,
"Nov-2004", 362, 1558,
"Dec-2004", 355, 1611,
"Jan-2005", 352, 1637,
"Feb-2005", 383, 1748,
"Mar-2005", 367, 1705,
"Apr-2005", 366, 1678,
"May-2005", 332, 1652,
"Jun-2005", 354, 1697,
"Jul-2005", 330, 1719,
"Aug-2005", 349, 1724,
"Sep-2005", 353, 1747,
"Oct-2005", 351, 1752,
"Nov-2005", 342, 1779,
"Dec-2005", 343, 1725,
"Jan-2006", 385, 1753,
"Feb-2006", 377, 1752,
"Mar-2006", 378, 1743,
"Apr-2006", 331, 1639,
"May-2006", 350, 1561,
"Jun-2006", 344, 1511,
"Jul-2006", 345, 1482,
"Aug-2006", 317, 1413,
"Sep-2006", 312, 1391,
"Oct-2006", 300, 1320,
"Nov-2006", 298, 1295,
"Dec-2006", 320, 1250,
"Jan-2007", 320, 1223,
"Feb-2007", 323, 1189,
"Mar-2007", 288, 1174,
"Apr-2007", 292, 1196,
"May-2007", 290, 1176,
"Jun-2007", 298, 1153,
"Jul-2007", 305, 1101,
"Aug-2007", 334, 1043,
"Sep-2007", 311, 978,
"Oct-2007", 336, 923,
"Nov-2007", 333, 882,
"Dec-2007", 327, 839,
"Jan-2008", 302, 804,
"Feb-2008", 307, 767,
"Mar-2008", 322, 742,
"Apr-2008", 329, 711,
"May-2008", 301, 696,
"Jun-2008", 341, 669,
"Jul-2008", 334, 647,
"Aug-2008", 315, 623,
"Sep-2008", 276, 586,
"Oct-2008", 252, 562,
"Nov-2008", 237, 513,
"Dec-2008", 195, 468,
"Jan-2009", 161, 407,
"Feb-2009", 171, 373,
"Mar-2009", 169, 356,
"Apr-2009", 156, 366,
"May-2009", 125, 383,
"Jun-2009", 109, 426,
"Jul-2009", 107, 466,
"Aug-2009", 96, 493,
"Sep-2009", 86, 502,
"Oct-2009", 77, 491,
"Nov-2009", 75, 494,
"Dec-2009", 82, 486,
"Jan-2010", 97, 497,
"Feb-2010", 93, 507,
"Mar-2010", 92, 526,
"Apr-2010", 98, 545,
"May-2010", 114, 522,
"Jun-2010", 113, 489,
"Jul-2010", 112, 443,
"Aug-2010", 131, 429,
"Sep-2010", 149, 431,
"Oct-2010", 144, 435,
"Nov-2010", 114, 446,
"Dec-2010", 103, 440,
"Jan-2011", 134, 437,
"Feb-2011", 145, 417,
"Mar-2011", 166, 417,
"Apr-2011", 145, 412,
"May-2011", 152, 419,
"Jun-2011", 153, 421,
"Jul-2011", 170, 427,
"Aug-2011", 176, 430,
"Sep-2011", 195, 424,
"Oct-2011", 189, 426,
"Nov-2011", 216, 441,
"Dec-2011", 196, 475,
"Jan-2012", 208, 502,
"Feb-2012", 205, 502,
"Mar-2012", 222, 485,
"Apr-2012", 237, 481,
"May-2012", 221, 498,
"Jun-2012", 224, 515,
"Jul-2012", 215, 520,
"Aug-2012", 225, 526,
"Sep-2012", 231, 549,
"Oct-2012", 258, 580,
"Nov-2012", 274, 591,
"Dec-2012", 310, 598,
"Jan-2013", 303, 596,
"Feb-2013", 319, 623,
"Mar-2013", 327, 626,
"Apr-2013", 315, 621,
"May-2013", 319, 606,
"Jun-2013", 265, 603,
"Jul-2013", 278, 605,
"Aug-2013", 266, 613,
"Sep-2013", 282, 600,
"Oct-2013", 296, 601,
"Nov-2013", 335, 624,
"Dec-2013", 362, 647,
"Jan-2014", 359, 638,
"Feb-2014", 343, 602,
"Mar-2014", 331, 603,
"Apr-2014", 357, 629,
"May-2014", 358, 651,
"Jun-2014", 352, 634,
"Jul-2014", 360, 638,
"Aug-2014", 355, 634,
"Sep-2014", 375, 654,
"Oct-2014", 358, 668,
"Nov-2014", 360, 672,
"Dec-2014", 358, 691,
"Jan-2015", 361, 693,
"Feb-2015", 347, 670,
"Mar-2015", 341, 640,
"Apr-2015", 365, 653,
"May-2015", 390, 692,
"Jun-2015", 440, 715,
"Jul-2015", 413, 719,
"Aug-2015", 421, 729,
"Sep-2015", 415, 744,
"Oct-2015", 408, 729,
"Nov-2015", 408, 741,
"Dec-2015", 379, 751,
"Jan-2016", 378, 769,
"Feb-2016", 368, 789,
"Mar-2016", 360, 784,
"Apr-2016", 376, 787,
"May-2016", 384, 756,
"Jun-2016", 402, 761,
"Jul-2016", 420, 760,
"Aug-2016", 436, 754,
"Sep-2016", 392, 758,
"Oct-2016", 393, 791,
"Nov-2016", 356, 825,
"Dec-2016", 416, 837,
"Jan-2017", 404, 815,
"Feb-2017", 432, 833,
"Mar-2017", 396, 835,
"Apr-2017", 367, 844,
"May-2017", 339, 816,
"Jun-2017", 342, 828,
"Jul-2017", 347, 830,
"Aug-2017", 335, 859,
"Sep-2017", 322, 849,
"Oct-2017", 333, 866,
"Nov-2017", 353, 889,
"Dec-2017", 365, 894,
"Jan-2018", 389, 894,
"Feb-2018", 400, 878,
"Mar-2018", 428, 889,
"Apr-2018", 404, 893,
"May-2018", 405, 906,
"Jun-2018", 365, 896,
"Jul-2018", 347, 883,
"Aug-2018", 346, 867,
"Sep-2018", 357, 877,
"Oct-2018", 367, 878,
"Nov-2018", 381, 856
)
housing$date <- seq.Date(as.Date("2000/1/1"), as.Date("2018/11/1"), by = "month")
ggplot(housing, aes(date, Housing.Starts.and.Completions)) + geom_line() + transition_reveal(date)
sales <- tibble::tribble(
~Date, ~Retail.Sales.Percent.Change,
"Jan-2000", 6,
"Feb-2000", 6.07,
"Mar-2000", 7.1,
"Apr-2000", 6.82,
"May-2000", 6.27,
"Jun-2000", 6.29,
"Jul-2000", 6.47,
"Aug-2000", 6.21,
"Sep-2000", 6.62,
"Oct-2000", 6.12,
"Nov-2000", 5.87,
"Dec-2000", 3.54,
"Jan-2001", 5.95,
"Feb-2001", 4.43,
"Mar-2001", 2.59,
"Apr-2001", 3.18,
"May-2001", 2.96,
"Jun-2001", 2.72,
"Jul-2001", 3.08,
"Aug-2001", 3.53,
"Sep-2001", 0.17,
"Oct-2001", 2.03,
"Nov-2001", 2.62,
"Dec-2001", 3.08,
"Jan-2002", 2.74,
"Feb-2002", 3.52,
"Mar-2002", 4,
"Apr-2002", 3.76,
"May-2002", 3.67,
"Jun-2002", 3.84,
"Jul-2002", 3.12,
"Aug-2002", 2.47,
"Sep-2002", 4.19,
"Oct-2002", 3.29,
"Nov-2002", 2.9,
"Dec-2002", 2.7,
"Jan-2003", 2.71,
"Feb-2003", 1.87,
"Mar-2003", 2.76,
"Apr-2003", 2.11,
"May-2003", 3.07,
"Jun-2003", 3.84,
"Jul-2003", 4.84,
"Aug-2003", 5.9,
"Sep-2003", 5.88,
"Oct-2003", 5.35,
"Nov-2003", 5.47,
"Dec-2003", 5.12,
"Jan-2004", 6.14,
"Feb-2004", 6.41,
"Mar-2004", 6.4,
"Apr-2004", 6.08,
"May-2004", 6,
"Jun-2004", 4.67,
"Jul-2004", 4.71,
"Aug-2004", 3.68,
"Sep-2004", 4.5,
"Oct-2004", 5.19,
"Nov-2004", 4.98,
"Dec-2004", 5.88,
"Jan-2005", 5.13,
"Feb-2005", 6.29,
"Mar-2005", 4.89,
"Apr-2005", 6.69,
"May-2005", 5.57,
"Jun-2005", 6.99,
"Jul-2005", 5.8,
"Aug-2005", 6.57,
"Sep-2005", 6.26,
"Oct-2005", 6.57,
"Nov-2005", 6.6,
"Dec-2005", 5.84,
"Jan-2006", 7.09,
"Feb-2006", 6.05,
"Mar-2006", 6.75,
"Apr-2006", 5.51,
"May-2006", 6.2,
"Jun-2006", 5.23,
"Jul-2006", 5.4,
"Aug-2006", 5.27,
"Sep-2006", 5.88,
"Oct-2006", 4.83,
"Nov-2006", 4.54,
"Dec-2006", 5.83,
"Jan-2007", 4.37,
"Feb-2007", 4.13,
"Mar-2007", 4.85,
"Apr-2007", 4.1,
"May-2007", 4.62,
"Jun-2007", 4.76,
"Jul-2007", 5.48,
"Aug-2007", 4.74,
"Sep-2007", 3.85,
"Oct-2007", 4.15,
"Nov-2007", 4.99,
"Dec-2007", 3.24,
"Jan-2008", 2.98,
"Feb-2008", 2.37,
"Mar-2008", 1.83,
"Apr-2008", 3.19,
"May-2008", 3.58,
"Jun-2008", 3.34,
"Jul-2008", 3.08,
"Aug-2008", 2.28,
"Sep-2008", 0.91,
"Oct-2008", -0.41,
"Nov-2008", -2.01,
"Dec-2008", -2.7,
"Jan-2009", -1.47,
"Feb-2009", -0.97,
"Mar-2009", -2.84,
"Apr-2009", -3.05,
"May-2009", -3.96,
"Jun-2009", -3.98,
"Jul-2009", -4.27,
"Aug-2009", -3.4,
"Sep-2009", -1.95,
"Oct-2009", -0.76,
"Nov-2009", -0.13,
"Dec-2009", 1.54,
"Jan-2010", 0.62,
"Feb-2010", 1.85,
"Mar-2010", 3.89,
"Apr-2010", 3.43,
"May-2010", 2.96,
"Jun-2010", 3.41,
"Jul-2010", 3.14,
"Aug-2010", 3.84,
"Sep-2010", 3.95,
"Oct-2010", 3.85,
"Nov-2010", 5.01,
"Dec-2010", 4.37,
"Jan-2011", 4.81,
"Feb-2011", 4.65,
"Mar-2011", 4.62,
"Apr-2011", 5.29,
"May-2011", 5.45,
"Jun-2011", 5.96,
"Jul-2011", 6.02,
"Aug-2011", 5.73,
"Sep-2011", 5.79,
"Oct-2011", 5.82,
"Nov-2011", 5.05,
"Dec-2011", 4.51,
"Jan-2012", 5.12,
"Feb-2012", 5.18,
"Mar-2012", 4.73,
"Apr-2012", 3.85,
"May-2012", 4.15,
"Jun-2012", 3.11,
"Jul-2012", 3.71,
"Aug-2012", 3.26,
"Sep-2012", 3.19,
"Oct-2012", 2.72,
"Nov-2012", 3.11,
"Dec-2012", 4.03,
"Jan-2013", 3.68,
"Feb-2013", 2.97,
"Mar-2013", 2.68,
"Apr-2013", 2.41,
"May-2013", 2.59,
"Jun-2013", 2.62,
"Jul-2013", 2.81,
"Aug-2013", 2.69,
"Sep-2013", 2.83,
"Oct-2013", 3.66,
"Nov-2013", 3.36,
"Dec-2013", 3.31,
"Jan-2014", 1.6,
"Feb-2014", 2.59,
"Mar-2014", 3.48,
"Apr-2014", 4.61,
"May-2014", 4.43,
"Jun-2014", 5.09,
"Jul-2014", 4.73,
"Aug-2014", 5.5,
"Sep-2014", 5.15,
"Oct-2014", 5.23,
"Nov-2014", 5.27,
"Dec-2014", 5.16,
"Jan-2015", 6.01,
"Feb-2015", 4.83,
"Mar-2015", 4.87,
"Apr-2015", 4.25,
"May-2015", 4.68,
"Jun-2015", 4.22,
"Jul-2015", 4.65,
"Aug-2015", 4,
"Sep-2015", 4.02,
"Oct-2015", 3.22,
"Nov-2015", 3.15,
"Dec-2015", 3.47,
"Jan-2016", 3.05,
"Feb-2016", 4.05,
"Mar-2016", 3.13,
"Apr-2016", 3.59,
"May-2016", 3.52,
"Jun-2016", 3.94,
"Jul-2016", 2.9,
"Aug-2016", 3.02,
"Sep-2016", 3.04,
"Oct-2016", 3.16,
"Nov-2016", 2.82,
"Dec-2016", 2.31,
"Jan-2017", 4.1,
"Feb-2017", 2.47,
"Mar-2017", 3.48,
"Apr-2017", 3.5,
"May-2017", 2.88,
"Jun-2017", 2.65,
"Jul-2017", 3.35,
"Aug-2017", 3.41,
"Sep-2017", 3.79,
"Oct-2017", 4.13,
"Nov-2017", 5.19,
"Dec-2017", 5.04,
"Jan-2018", 3.67,
"Feb-2018", 4.58,
"Mar-2018", 4.46,
"Apr-2018", 4.31,
"May-2018", 5.71,
"Jun-2018", 5.48,
"Jul-2018", 6.19,
"Aug-2018", 5.54,
"Sep-2018", 4.84,
"Oct-2018", 5,
"Nov-2018", 4.62
)
sales$date <- seq.Date(as.Date("2000/1/1"), as.Date("2018/11/1"), by = "month")
head(sales$date)
## [1] "2000-01-01" "2000-02-01" "2000-03-01" "2000-04-01" "2000-05-01"
## [6] "2000-06-01"
library(tidyverse)
library(lubridate)
##
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
##
## date
head(sales$date)
## [1] "2000-01-01" "2000-02-01" "2000-03-01" "2000-04-01" "2000-05-01"
## [6] "2000-06-01"
ss = sales %>%
mutate(year = ymd(sales$date)) %>%
mutate_at(vars(date), funs(year))
## Warning: funs() is soft deprecated as of dplyr 0.8.0
## Please use a list of either functions or lambdas:
##
## # Simple named list:
## list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`:
## tibble::lst(mean, median)
##
## # Using lambdas
## list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## This warning is displayed once per session.
dd = d %>%
group_by(MONTH) %>%
summarize(avgspeed = mean(TRAV_SP, na.rm = TRUE))
salestwo = ss %>%
group_by(date) %>%
summarize(average = mean(Retail.Sales.Percent.Change, na.rm = TRUE))
salestwo$zscores <- round((salestwo$average - mean(salestwo$average, na.rm = TRUE))/sd(salestwo$average, na.rm = TRUE), 2)
salestwo$zscores
## [1] 1.19 -0.45 -0.28 0.11 0.81 1.19 0.98 0.30 -1.25 -3.19 -0.27
## [12] 0.76 -0.02 -0.48 0.28 0.22 -0.35 -0.11 0.57
salestwo$zscoretype <- ifelse(salestwo$zscores < 0, "below", "above")
salestwo$zscoretype
## [1] "above" "below" "below" "above" "above" "above" "above" "above"
## [9] "below" "below" "below" "above" "below" "below" "above" "above"
## [17] "below" "below" "above"
ggplot(salestwo, aes(x = date, y = zscores)) +
geom_bar(stat = "identity", aes(fill = zscoretype)) +
scale_fill_manual(name="Standardized Retail Sales", labels = c("Above Average", "Below Average"), values = c("above"="#00ba38", "below"="#f8766d")) +
transition_states(date) +
coord_flip()